home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / src / load-save.cc < prev    next >
C/C++ Source or Header  |  1997-05-26  |  56KB  |  2,617 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. #ifdef HAVE_CONFIG_H
  24. #include <config.h>
  25. #endif
  26.  
  27. #include <cfloat>
  28. #include <cstring>
  29. #include <cctype>
  30.  
  31. #include <string>
  32.  
  33. #include <iostream.h>
  34. #include <fstream.h>
  35. #include <strstream.h>
  36.  
  37. #include "byte-swap.h"
  38. #include "data-conv.h"
  39. #include "mach-info.h"
  40. #include "oct-glob.h"
  41. #include "str-vec.h"
  42.  
  43. #include "defun.h"
  44. #include "error.h"
  45. #include "gripes.h"
  46. #include "help.h"
  47. #include "load-save.h"
  48. #include "mappers.h"
  49. #include "oct-obj.h"
  50. #include "pager.h"
  51. #include "pt-exp.h"
  52. #include "pt-fvc.h"
  53. #include "symtab.h"
  54. #include "sysdep.h"
  55. #include "unwind-prot.h"
  56. #include "utils.h"
  57. #include "variables.h"
  58.  
  59. // The default output format.  May be one of "binary", "text", or
  60. // "mat-binary".
  61. static string Vdefault_save_format;
  62.  
  63. // The number of decimal digits to use when writing ascii data.
  64. static int Vsave_precision;
  65.  
  66. // Used when converting Inf to something that gnuplot can read.
  67.  
  68. #ifndef OCT_RBV
  69. #define OCT_RBV DBL_MAX / 100.0
  70. #endif
  71.  
  72. enum load_save_format
  73.   {
  74.     LS_ASCII,
  75.     LS_BINARY,
  76.     LS_MAT_ASCII,
  77.     LS_MAT_BINARY,
  78.     LS_UNKNOWN,
  79.   };
  80.  
  81. // XXX FIXME XXX -- shouldn't this be implemented in terms of other
  82. // functions that are already available?
  83.  
  84. // Install a variable with name NAME and the value specified TC in the
  85. // symbol table.  If FORCE is nonzero, replace any existing definition
  86. // for NAME.  If GLOBAL is nonzero, make the variable global.
  87. //
  88. // Assumes TC is defined.
  89.  
  90. static void
  91. install_loaded_variable (int force, char *name, const octave_value& val,
  92.              int global, char *doc)
  93. {
  94.   // Is there already a symbol by this name?  If so, what is it?
  95.  
  96.   symbol_record *lsr = curr_sym_tab->lookup (name, 0, 0);
  97.  
  98.   int is_undefined = 1;
  99.   int is_variable = 0;
  100.   int is_function = 0;
  101.   int is_global = 0;
  102.  
  103.   if (lsr)
  104.     {
  105.       is_undefined = ! lsr->is_defined ();
  106.       is_variable = lsr->is_variable ();
  107.       is_function = lsr->is_function ();
  108.       is_global = lsr->is_linked_to_global ();
  109.     }
  110.  
  111.   symbol_record *sr = 0;
  112.  
  113.   if (global)
  114.     {
  115.       if (is_global || is_undefined)
  116.     {
  117.       if (force || is_undefined)
  118.         {
  119.           lsr = curr_sym_tab->lookup (name, 1, 0);
  120.           link_to_global_variable (lsr);
  121.           sr = lsr;
  122.         }
  123.       else
  124.         {
  125.           warning ("load: global variable name `%s' exists.", name);
  126.           warning ("use `load -force' to overwrite");
  127.         }
  128.     }
  129.       else if (is_function)
  130.     {
  131.       if (force)
  132.         {
  133.           lsr = curr_sym_tab->lookup (name, 1, 0);
  134.           link_to_global_variable (lsr);
  135.           sr = lsr;
  136.         }
  137.       else
  138.         {
  139.           warning ("load: `%s' is currently a function in this scope", name);
  140.           warning ("`load -force' will load variable and hide function");
  141.         }
  142.     }
  143.       else if (is_variable)
  144.     {
  145.       if (force)
  146.         {
  147.           lsr = curr_sym_tab->lookup (name, 1, 0);
  148.           link_to_global_variable (lsr);
  149.           sr = lsr;
  150.         }
  151.       else
  152.         {
  153.           warning ("load: local variable name `%s' exists.", name);
  154.           warning ("use `load -force' to overwrite");
  155.         }
  156.     }
  157.       else
  158.     error ("load: unable to load data for unknown symbol type");
  159.     }
  160.   else
  161.     {
  162.       if (is_global)
  163.     {
  164.       if (force || is_undefined)
  165.         {
  166.           lsr = curr_sym_tab->lookup (name, 1, 0);
  167.           link_to_global_variable (lsr);
  168.           sr = lsr;
  169.         }
  170.       else
  171.         {
  172.           warning ("load: global variable name `%s' exists.", name);
  173.           warning ("use `load -force' to overwrite");
  174.         }
  175.     }
  176.       else if (is_function)
  177.     {
  178.       if (force)
  179.         {
  180.           lsr = curr_sym_tab->lookup (name, 1, 0);
  181.           link_to_global_variable (lsr);
  182.           sr = lsr;
  183.         }
  184.       else
  185.         {
  186.           warning ("load: `%s' is currently a function in this scope", name);
  187.           warning ("`load -force' will load variable and hide function");
  188.         }
  189.     }
  190.       else if (is_variable || is_undefined)
  191.     {
  192.       if (force || is_undefined)
  193.         {
  194.           lsr = curr_sym_tab->lookup (name, 1, 0);
  195.           sr = lsr;
  196.         }
  197.       else
  198.         {
  199.           warning ("load: local variable name `%s' exists.", name);
  200.           warning ("use `load -force' to overwrite");
  201.         }
  202.     }
  203.       else
  204.     error ("load: unable to load data for unknown symbol type");
  205.     }
  206.  
  207.   if (sr)
  208.     {
  209.       sr->define (val);
  210.       if (doc)
  211.     sr->document (doc);
  212.       return;
  213.     }
  214.   else
  215.     error ("load: unable to load variable `%s'", name);
  216.  
  217.   return;
  218. }
  219.  
  220. // Functions for reading ascii data.
  221.  
  222. // Skip white space and comments on stream IS.
  223.  
  224. static void
  225. skip_comments (istream& is)
  226. {
  227.   char c = '\0';
  228.   while (is.get (c))
  229.     {
  230.       if (c == ' ' || c == '\t' || c == '\n')
  231.     ; // Skip whitespace on way to beginning of next line.
  232.       else
  233.     break;
  234.     }
  235.  
  236.   for (;;)
  237.     {
  238.       if (is && c == '#')
  239.     while (is.get (c) && c != '\n')
  240.       ; // Skip to beginning of next line, ignoring everything.
  241.       else
  242.     break;
  243.     }
  244. }
  245.  
  246. // Extract a KEYWORD and its value from stream IS, returning the
  247. // associated value in a new string.
  248. //
  249. // Input should look something like:
  250. //
  251. //  #[ \t]*keyword[ \t]*:[ \t]*string-value[ \t]*\n
  252.  
  253. static char *
  254. extract_keyword (istream& is, char *keyword)
  255. {
  256.   char *retval = 0;
  257.  
  258.   char c;
  259.   while (is.get (c))
  260.     {
  261.       if (c == '#')
  262.     {
  263.       ostrstream buf;
  264.     
  265.       while (is.get (c) && (c == ' ' || c == '\t' || c == '#'))
  266.         ; // Skip whitespace and comment characters.
  267.  
  268.       if (isalpha (c))
  269.         buf << c;
  270.  
  271.       while (is.get (c) && isalpha (c))
  272.         buf << c;
  273.  
  274.       buf << ends;
  275.       char *tmp = buf.str ();
  276.       int match = (strncmp (tmp, keyword, strlen (keyword)) == 0);
  277.       delete [] tmp;
  278.  
  279.       if (match)
  280.         {
  281.           ostrstream value;
  282.           while (is.get (c) && (c == ' ' || c == '\t' || c == ':'))
  283.         ; // Skip whitespace and the colon.
  284.  
  285.           if (c != '\n')
  286.         {
  287.           value << c;
  288.           while (is.get (c) && c != '\n')
  289.             value << c;
  290.         }
  291.           value << ends;
  292.           retval = value.str ();
  293.           break;
  294.         }
  295.     }
  296.     }
  297.  
  298.   if (retval)
  299.     {
  300.       int len = strlen (retval);
  301.       if (len > 0)
  302.     {
  303.       char *ptr = retval + len - 1;
  304.       while (*ptr == ' ' || *ptr == '\t')
  305.         ptr--;
  306.       *(ptr+1) = '\0';
  307.     }
  308.     }
  309.  
  310.   return retval;
  311. }
  312.  
  313. // Match KEYWORD on stream IS, placing the associated value in VALUE,
  314. // returning 1 if successful and 0 otherwise.
  315. //
  316. // Input should look something like:
  317. //
  318. //  [ \t]*keyword[ \t]*int-value.*\n
  319.  
  320. static int
  321. extract_keyword (istream& is, char *keyword, int& value)
  322. {
  323.   int status = 0;
  324.   value = 0;
  325.  
  326.   char c;
  327.   while (is.get (c))
  328.     {
  329.       if (c == '#')
  330.     {
  331.       ostrstream buf;
  332.  
  333.       while (is.get (c) && (c == ' ' || c == '\t' || c == '#'))
  334.         ; // Skip whitespace and comment characters.
  335.  
  336.       if (isalpha (c))
  337.         buf << c;
  338.  
  339.       while (is.get (c) && isalpha (c))
  340.         buf << c;
  341.  
  342.       buf << ends;
  343.       char *tmp = buf.str ();
  344.       int match = (strncmp (tmp, keyword, strlen (keyword)) == 0);
  345.       delete [] tmp;
  346.  
  347.       if (match)
  348.         {
  349.           while (is.get (c) && (c == ' ' || c == '\t' || c == ':'))
  350.         ; // Skip whitespace and the colon.
  351.  
  352.           is.putback (c);
  353.           if (c != '\n')
  354.         is >> value;
  355.           if (is)
  356.         status = 1;
  357.           while (is.get (c) && c != '\n')
  358.         ; // Skip to beginning of next line;
  359.           break;
  360.         }
  361.     }
  362.     }
  363.   return status;
  364. }
  365.  
  366. // Extract one value (scalar, matrix, string, etc.) from stream IS and
  367. // place it in TC, returning the name of the variable.  If the value
  368. // is tagged as global in the file, return nonzero in GLOBAL.
  369. //
  370. // FILENAME is used for error messages.
  371. //
  372. // The data is expected to be in the following format:
  373. //
  374. // The input file must have a header followed by some data.
  375. //
  376. // All lines in the header must begin with a `#' character.
  377. //
  378. // The header must contain a list of keyword and value pairs with the
  379. // keyword and value separated by a colon.
  380. //
  381. // Keywords must appear in the following order:
  382. //
  383. // # name: <name>
  384. // # type: <type>
  385. // # <info>
  386. //
  387. // Where:
  388. //
  389. //  <name> : a valid identifier
  390. //
  391. //  <type> : <typename>
  392. //         | global <typename>
  393. //
  394. //  <typename> : scalar
  395. //             | complex scalar
  396. //             | matrix
  397. //             | complex matrix
  398. //             | string
  399. //             | range
  400. //             | string array
  401. //
  402. //  <info> : <matrix info>
  403. //         | <string info>
  404. //         | <string array info>
  405. //
  406. //  <matrix info> : # rows: <integer>
  407. //                : # columns: <integer>
  408. //
  409. //  <string info> : # length: <integer>
  410. //
  411. //  <string array info> : # elements: <integer>
  412. //                      : # length: <integer> (once before each string)
  413. //
  414. // Formatted ASCII data follows the header.
  415. //
  416. // Example:
  417. //
  418. //  # name: foo
  419. //  # type: matrix
  420. //  # rows: 2
  421. //  # columns: 2
  422. //    2  4
  423. //    1  3
  424. //
  425. // Example:
  426. //
  427. //  # name: foo
  428. //  # type: string array
  429. //  # elements: 5
  430. //  # length: 4
  431. //  this
  432. //  # length: 2
  433. //  is
  434. //  # length: 1
  435. //  a
  436. //  # length: 6
  437. //  string
  438. //  # length: 5
  439. //  array
  440. //
  441. // XXX FIXME XXX -- this format is fairly rigid, and doesn't allow for
  442. // arbitrary comments, etc.  Someone should fix that.
  443.  
  444. static char *
  445. read_ascii_data (istream& is, const string& filename, int& global,
  446.          octave_value& tc)
  447. {
  448.   // Read name for this entry or break on EOF.
  449.  
  450.   char *name = extract_keyword (is, "name");
  451.  
  452.   if (! name)
  453.     return 0;
  454.  
  455.   if (! *name)
  456.     {
  457.       error ("load: empty name keyword found in file `%s'",
  458.          filename.c_str ());
  459.       delete [] name;
  460.       return 0;
  461.     }
  462.       
  463.  
  464.   if (! valid_identifier (name))
  465.     {
  466.       error ("load: bogus identifier `%s' found in file `%s'", name,
  467.          filename.c_str ());
  468.       delete [] name;
  469.       return 0;
  470.     }
  471.  
  472.   // Look for type keyword.
  473.  
  474.   char *tag = extract_keyword (is, "type");
  475.  
  476.   if (tag && *tag)
  477.     {
  478.       char *ptr = strchr (tag, ' ');
  479.       if (ptr)
  480.     {
  481.       *ptr = '\0';
  482.       global = (strncmp (tag, "global", 6) == 0);
  483.       *ptr = ' ';
  484.       if (global)
  485.         ptr++;
  486.       else
  487.         ptr = tag;
  488.     }
  489.       else
  490.     ptr = tag;
  491.  
  492.       if (strncmp (ptr, "scalar", 6) == 0)
  493.     {
  494.       double tmp;
  495.       is >> tmp;
  496.       if (is)
  497.         tc = tmp;
  498.       else
  499.         error ("load: failed to load scalar constant");
  500.     }
  501.       else if (strncmp (ptr, "matrix", 6) == 0)
  502.     {
  503.       int nr = 0, nc = 0;
  504.  
  505.       if (extract_keyword (is, "rows", nr) && nr >= 0
  506.           && extract_keyword (is, "columns", nc) && nc >= 0)
  507.         {
  508.           if (nr > 0 && nc > 0)
  509.         {
  510.           Matrix tmp (nr, nc);
  511.           is >> tmp;
  512.           if (is)
  513.             tc = tmp;
  514.           else
  515.             error ("load: failed to load matrix constant");
  516.         }
  517.           else if (nr == 0 || nc == 0)
  518.         tc = Matrix (nr, nc);
  519.           else
  520.         panic_impossible ();
  521.         }
  522.       else
  523.         error ("load: failed to extract number of rows and columns");
  524.     }
  525.       else if (strncmp (ptr, "complex scalar", 14) == 0)
  526.     {
  527.       Complex tmp;
  528.       is >> tmp;
  529.       if (is)
  530.         tc = tmp;
  531.       else
  532.         error ("load: failed to load complex scalar constant");
  533.     }
  534.       else if (strncmp (ptr, "complex matrix", 14) == 0)
  535.     {
  536.       int nr = 0, nc = 0;
  537.  
  538.       if (extract_keyword (is, "rows", nr) && nr > 0
  539.           && extract_keyword (is, "columns", nc) && nc > 0)
  540.         {
  541.           ComplexMatrix tmp (nr, nc);
  542.           is >> tmp;
  543.           if (is)
  544.         tc = tmp;
  545.           else
  546.         error ("load: failed to load complex matrix constant");
  547.         }
  548.       else
  549.         error ("load: failed to extract number of rows and columns");
  550.     }
  551.       else if (strncmp (ptr, "string array", 12) == 0)
  552.     {
  553.       int elements;
  554.       if (extract_keyword (is, "elements", elements) && elements > 0)
  555.         {
  556.           // XXX FIXME XXX -- need to be able to get max length
  557.           // before doing anything.
  558.  
  559.           charMatrix chm (elements, 0);
  560.           int max_len = 0;
  561.           for (int i = 0; i < elements; i++)
  562.         {
  563.           int len;
  564.           if (extract_keyword (is, "length", len) && len > 0)
  565.             {
  566.               char *tmp = new char [len+1];
  567.               if (! is.read (tmp, len))
  568.             {
  569.               error ("load: failed to load string constant");
  570.               break;
  571.             }
  572.               else
  573.             {
  574.               tmp [len] = '\0';
  575.               if (len > max_len)
  576.                 {
  577.                   max_len = len;
  578.                   chm.resize (elements, max_len, 0);
  579.                 }
  580.               chm.insert (tmp, i, 0);
  581.             }
  582.               delete [] tmp;
  583.             }
  584.           else
  585.             error ("load: failed to extract string length for element %d", i+1);
  586.         }
  587.  
  588.           if (! error_state)
  589.         tc = octave_value (chm, true);
  590.         }
  591.       else
  592.         error ("load: failed to extract number of string elements");
  593.     }
  594.       else if (strncmp (ptr, "string", 6) == 0)
  595.     {
  596.       int len;
  597.       if (extract_keyword (is, "length", len) && len > 0)
  598.         {
  599.           char *tmp = new char [len+1];
  600.           is.get (tmp, len+1, EOF);
  601.           if (is)
  602.         tc = tmp;
  603.           else
  604.         error ("load: failed to load string constant");
  605.         }
  606.       else
  607.         error ("load: failed to extract string length");
  608.     }
  609.       else if (strncmp (ptr, "range", 5) == 0)
  610.     {
  611.       // # base, limit, range comment added by save().
  612.  
  613.       skip_comments (is);
  614.       Range tmp;
  615.       is >> tmp;
  616.       if (is)
  617.         tc = tmp;
  618.       else
  619.         error ("load: failed to load range constant");
  620.     }
  621.       else
  622.     error ("load: unknown constant type `%s'", tag);
  623.     }
  624.   else
  625.     error ("load: failed to extract keyword specifying value type");
  626.  
  627.   delete [] tag;
  628.  
  629.   if (error_state)
  630.     {
  631.       error ("load: reading file %s", filename.c_str ());
  632.       return 0;
  633.     }
  634.  
  635.   return name;
  636. }
  637.  
  638. // Extract one value (scalar, matrix, string, etc.) from stream IS and
  639. // place it in TC, returning the name of the variable.  If the value
  640. // is tagged as global in the file, return nonzero in GLOBAL.  If SWAP
  641. // is nonzero, swap bytes after reading.
  642. //
  643. // The data is expected to be in the following format:
  644. //
  645. // Header (one per file):
  646. // =====================
  647. //
  648. //   object               type            bytes
  649. //   ------               ----            -----
  650. //   magic number         string             10
  651. //
  652. //   float format         integer             1  
  653. //
  654. //
  655. // Data (one set for each item):
  656. // ============================
  657. //
  658. //   object               type            bytes
  659. //   ------               ----            -----
  660. //   name_length          integer             4
  661. //
  662. //   name                 string    name_length
  663. //
  664. //   doc_length           integer             4
  665. //
  666. //   doc                  string     doc_length
  667. //
  668. //   global flag          integer             1
  669. //
  670. //   data type            integer             1
  671. //
  672. //   data (one of):
  673. //
  674. //     scalar:
  675. //       data             real                8
  676. //
  677. //     complex scalar:
  678. //       data             complex            16
  679. //
  680. //     matrix:
  681. //       rows             integer             4
  682. //       columns          integer             4
  683. //       data             real            r*c*8
  684. //
  685. //     complex matrix:
  686. //       rows             integer             4
  687. //       columns          integer             4
  688. //       data             complex        r*c*16
  689. //
  690. //     string:
  691. //       length           int                 4
  692. //       data             string         length
  693. //
  694. //     range:
  695. //       base             real                8
  696. //       limit            real                8
  697. //       increment        real                8
  698. //
  699. //     string array
  700. //       elements         int                 4
  701. //
  702. //       for each element:
  703. //         length         int                 4
  704. //         data           string         length
  705. //
  706. // FILENAME is used for error messages.
  707.  
  708. static char *
  709. read_binary_data (istream& is, int swap,
  710.           oct_mach_info::float_format fmt,
  711.           const string& filename, int& global,
  712.           octave_value& tc, char *&doc)
  713. {
  714.   char tmp = 0;
  715.  
  716.   FOUR_BYTE_INT name_len = 0, doc_len = 0;
  717.   char *name = 0;
  718.  
  719.   doc = 0;
  720.  
  721.   // We expect to fail here, at the beginning of a record, so not
  722.   // being able to read another name should not result in an error.
  723.  
  724.   is.read (&name_len, 4);
  725.   if (! is)
  726.     return 0;
  727.   if (swap)
  728.     swap_4_bytes ((char *) &name_len);
  729.  
  730.   name = new char [name_len+1];
  731.   name[name_len] = '\0';
  732.   if (! is.read (name, name_len))
  733.     goto data_read_error;
  734.  
  735.   is.read (&doc_len, 4);
  736.   if (! is)
  737.     goto data_read_error;
  738.   if (swap)
  739.     swap_4_bytes ((char *) &doc_len);
  740.  
  741.   doc = new char [doc_len+1];
  742.   doc[doc_len] = '\0';
  743.   if (! is.read (doc, doc_len))
  744.     goto data_read_error;
  745.  
  746.   if (! is.read (&tmp, 1))
  747.     goto data_read_error;
  748.   global = tmp ? 1 : 0;
  749.  
  750.   tmp = 0;
  751.   if (! is.read (&tmp, 1))
  752.     goto data_read_error;
  753.  
  754.   switch (tmp)
  755.     {
  756.     case 1:
  757.       {
  758.     if (! is.read (&tmp, 1))
  759.       goto data_read_error;
  760.     double dtmp;
  761.     read_doubles (is, &dtmp, (save_type) tmp, 1, swap, fmt);
  762.     if (error_state || ! is)
  763.       goto data_read_error;
  764.     tc = dtmp;
  765.       }
  766.       break;
  767.  
  768.     case 2:
  769.       {
  770.     FOUR_BYTE_INT nr, nc;
  771.     if (! is.read (&nr, 4))
  772.       goto data_read_error;
  773.     if (swap)
  774.       swap_4_bytes ((char *) &nr);
  775.     if (! is.read (&nc, 4))
  776.       goto data_read_error;
  777.     if (swap)
  778.       swap_4_bytes ((char *) &nc);
  779.     if (! is.read (&tmp, 1))
  780.       goto data_read_error;
  781.     Matrix m (nr, nc);
  782.     double *re = m.fortran_vec ();
  783.     int len = nr * nc;
  784.     read_doubles (is, re, (save_type) tmp, len, swap, fmt);
  785.     if (error_state || ! is)
  786.       goto data_read_error;
  787.     tc = m;
  788.       }
  789.       break;
  790.  
  791.     case 3:
  792.       {
  793.     if (! is.read (&tmp, 1))
  794.       goto data_read_error;
  795.     Complex ctmp;
  796.     read_doubles (is, (double *) &ctmp, (save_type) tmp, 2, swap, fmt);
  797.     if (error_state || ! is)
  798.       goto data_read_error;
  799.     tc = ctmp;
  800.       }
  801.       break;
  802.  
  803.     case 4:
  804.       {
  805.     FOUR_BYTE_INT nr, nc;
  806.     if (! is.read (&nr, 4))
  807.       goto data_read_error;
  808.     if (swap)
  809.       swap_4_bytes ((char *) &nr);
  810.     if (! is.read (&nc, 4))
  811.       goto data_read_error;
  812.     if (swap)
  813.       swap_4_bytes ((char *) &nc);
  814.     if (! is.read (&tmp, 1))
  815.       goto data_read_error;
  816.     ComplexMatrix m (nr, nc);
  817.     Complex *im = m.fortran_vec ();
  818.     int len = nr * nc;
  819.     read_doubles (is, (double *) im, (save_type) tmp, 2*len,
  820.               swap, fmt);
  821.     if (error_state || ! is)
  822.       goto data_read_error;
  823.     tc = m;
  824.       }
  825.       break;
  826.  
  827.     case 5:
  828.       {
  829.     FOUR_BYTE_INT len;
  830.     if (! is.read (&len, 4))
  831.       goto data_read_error;
  832.     if (swap)
  833.       swap_4_bytes ((char *) &len);
  834.     char *s = new char [len+1];
  835.     if (! is.read (s, len))
  836.       {
  837.         delete [] s;
  838.         goto data_read_error;
  839.       }
  840.     s[len] = '\0';
  841.     tc = s;
  842.       }
  843.       break;
  844.  
  845.     case 6:
  846.       {
  847.     if (! is.read (&tmp, 1))
  848.       goto data_read_error;
  849.     double bas, lim, inc;
  850.     if (! is.read (&bas, 8))
  851.       goto data_read_error;
  852.     if (swap)
  853.       swap_8_bytes ((char *) &bas);
  854.     if (! is.read (&lim, 8))
  855.       goto data_read_error;
  856.     if (swap)
  857.       swap_8_bytes ((char *) &lim);
  858.     if (! is.read (&inc, 8))
  859.       goto data_read_error;
  860.     if (swap)
  861.       swap_8_bytes ((char *) &inc);
  862.     Range r (bas, lim, inc);
  863.     tc = r;
  864.       }
  865.       break;
  866.  
  867.     case 7:
  868.       {
  869.     FOUR_BYTE_INT elements;
  870.     if (! is.read (&elements, 4))
  871.       goto data_read_error;
  872.     if (swap)
  873.       swap_4_bytes ((char *) &elements);
  874.     charMatrix chm (elements, 0);
  875.     int max_len = 0;
  876.     for (int i = 0; i < elements; i++)
  877.       {
  878.         FOUR_BYTE_INT len;
  879.         if (! is.read (&len, 4))
  880.           goto data_read_error;
  881.         if (swap)
  882.           swap_4_bytes ((char *) &len);
  883.         char *tmp = new char [len+1];
  884.         if (! is.read (tmp, len))
  885.           {
  886.         delete [] tmp;
  887.         goto data_read_error;
  888.           }
  889.         if (len > max_len)
  890.           {
  891.         max_len = len;
  892.         chm.resize (elements, max_len, 0);
  893.           }
  894.         tmp [len] = '\0';
  895.         chm.insert (tmp, i, 0);
  896.         delete [] tmp;
  897.       }
  898.     tc = octave_value (chm, true);
  899.       }
  900.       break;
  901.  
  902.     default:
  903.     data_read_error:
  904.       error ("load: trouble reading binary file `%s'", filename.c_str ());
  905.       delete [] name;
  906.       name = 0;
  907.       break;
  908.     }
  909.  
  910.   return name;
  911. }
  912.  
  913. static void
  914. get_lines_and_columns (istream& is, const string& filename, int& nr, int& nc)
  915. {
  916.   streampos pos = is.tellg ();
  917.  
  918.   int file_line_number = 0;
  919.  
  920.   nr = 0;
  921.   nc = 0;
  922.  
  923.   while (is && ! error_state)
  924.     {
  925.       string buf;
  926.  
  927.       char c;
  928.       while (is.get (c))
  929.     {
  930.       if (c == '\n')
  931.         break;
  932.  
  933.       buf += c;
  934.     }
  935.  
  936.       file_line_number++;
  937.  
  938.       size_t beg = buf.find_first_not_of (" \t");
  939.  
  940.       int tmp_nc = 0;
  941.  
  942.       while (beg != NPOS)
  943.     {
  944.       tmp_nc++;
  945.  
  946.       size_t end = buf.find_first_of (" \t", beg);
  947.  
  948.       if (end != NPOS)
  949.         beg = buf.find_first_not_of (" \t", end);
  950.       else
  951.         break;
  952.     }
  953.  
  954.       if (tmp_nc > 0)
  955.     {
  956.       if (nc == 0)
  957.         {
  958.           nc = tmp_nc;
  959.           nr++;
  960.         }
  961.       else if (nc == tmp_nc)
  962.         nr++;
  963.       else
  964.         error ("load: %s: inconsistent number of columns near line %d",
  965.            filename.c_str (), file_line_number);
  966.     }
  967.     }
  968.  
  969.   if (nr == 0 || nc == 0)
  970.     error ("load: file `%s' seems to be empty!", filename.c_str ());
  971.  
  972.   is.clear ();
  973.   is.seekg (pos, ios::beg);
  974. }
  975.  
  976. // Extract a matrix from a file of numbers only.
  977. //
  978. // Comments are not allowed.  The file should only have numeric values.
  979. //
  980. // Reads the file twice.  Once to find the number of rows and columns,
  981. // and once to extract the matrix.
  982. //
  983. // FILENAME is used for error messages.
  984. //
  985. // This format provides no way to tag the data as global.
  986.  
  987. static char *
  988. read_mat_ascii_data (istream& is, const string& filename,
  989.              octave_value& tc)
  990. {
  991.   char *name = 0;
  992.  
  993.   string varname;
  994.  
  995.   size_t pos = filename.find ('.');
  996.  
  997.   if (pos != NPOS)
  998.     varname = filename.substr (0, pos);
  999.   else
  1000.     varname = filename;
  1001.  
  1002.   if (valid_identifier (varname.c_str ()))
  1003.     {
  1004.       int nr = 0;
  1005.       int nc = 0;
  1006.  
  1007.       get_lines_and_columns (is, filename, nr, nc);
  1008.  
  1009.       if (! error_state && nr > 0 && nc > 0)
  1010.     {
  1011.       Matrix tmp (nr, nc);
  1012.  
  1013.       is >> tmp;
  1014.  
  1015.       if (is)
  1016.         {
  1017.           tc = tmp;
  1018.  
  1019.           name = strsave (varname.c_str ());
  1020.         }
  1021.       else
  1022.         error ("load: failed to read matrix from file `%s'",
  1023.            filename.c_str ());
  1024.     }
  1025.       else
  1026.     error ("load: unable to extract matrix size from file `%s'",
  1027.            filename.c_str ());
  1028.     }
  1029.   else
  1030.     error ("load: unable to convert filename `%s' to valid identifier",
  1031.        filename.c_str ());
  1032.  
  1033.   return name;
  1034. }
  1035.  
  1036. // Read LEN elements of data from IS in the format specified by
  1037. // PRECISION, placing the result in DATA.  If SWAP is nonzero, swap
  1038. // the bytes of each element before copying to DATA.  FLT_FMT
  1039. // specifies the format of the data if we are reading floating point
  1040. // numbers.
  1041.  
  1042. static void
  1043. read_mat_binary_data (istream& is, double *data, int precision,
  1044.               int len, int swap,
  1045.               oct_mach_info::float_format flt_fmt)
  1046. {
  1047.   switch (precision)
  1048.     {
  1049.     case 0:
  1050.       read_doubles (is, data, LS_DOUBLE, len, swap, flt_fmt);
  1051.       break;
  1052.  
  1053.     case 1:
  1054.       read_doubles (is, data, LS_FLOAT, len, swap, flt_fmt);
  1055.       break;
  1056.  
  1057.     case 2:
  1058.       read_doubles (is, data, LS_INT, len, swap, flt_fmt);
  1059.       break;
  1060.  
  1061.     case 3:
  1062.       read_doubles (is, data, LS_SHORT, len, swap, flt_fmt);
  1063.       break;
  1064.  
  1065.     case 4:
  1066.       read_doubles (is, data, LS_U_SHORT, len, swap, flt_fmt);
  1067.       break;
  1068.  
  1069.     case 5:
  1070.       read_doubles (is, data, LS_U_CHAR, len, swap, flt_fmt);
  1071.       break;
  1072.  
  1073.     default:
  1074.       break;
  1075.     }
  1076. }
  1077.  
  1078. static int
  1079. read_mat_file_header (istream& is, int& swap, FOUR_BYTE_INT& mopt, 
  1080.               FOUR_BYTE_INT& nr, FOUR_BYTE_INT& nc,
  1081.               FOUR_BYTE_INT& imag, FOUR_BYTE_INT& len,
  1082.               int quiet = 0)
  1083. {
  1084.   swap = 0;
  1085.  
  1086.   // We expect to fail here, at the beginning of a record, so not
  1087.   // being able to read another mopt value should not result in an
  1088.   // error.
  1089.  
  1090.   is.read (&mopt, 4);
  1091.   if (! is)
  1092.     return 1;
  1093.  
  1094.   if (! is.read (&nr, 4))
  1095.     goto data_read_error;
  1096.  
  1097.   if (! is.read (&nc, 4))
  1098.     goto data_read_error;
  1099.  
  1100.   if (! is.read (&imag, 4))
  1101.     goto data_read_error;
  1102.  
  1103.   if (! is.read (&len, 4))
  1104.     goto data_read_error;
  1105.  
  1106. // If mopt is nonzero and the byte order is swapped, mopt will be
  1107. // bigger than we expect, so we swap bytes.
  1108. //
  1109. // If mopt is zero, it means the file was written on a little endian
  1110. // machine, and we only need to swap if we are running on a big endian
  1111. // machine.
  1112. //
  1113. // Gag me.
  1114.  
  1115.   if (oct_mach_info::words_big_endian () && mopt == 0)
  1116.     swap = 1;
  1117.  
  1118.   // mopt is signed, therefore byte swap may result in negative value.
  1119.  
  1120.   if (mopt > 9999 || mopt < 0)
  1121.     swap = 1;
  1122.  
  1123.   if (swap)
  1124.     {
  1125.       swap_4_bytes ((char *) &mopt);
  1126.       swap_4_bytes ((char *) &nr);
  1127.       swap_4_bytes ((char *) &nc);
  1128.       swap_4_bytes ((char *) &imag);
  1129.       swap_4_bytes ((char *) &len);
  1130.     }
  1131.  
  1132.   if (mopt > 9999 || mopt < 0 || imag > 1 || imag < 0)
  1133.     {
  1134.       if (! quiet)
  1135.     error ("load: can't read binary file");
  1136.       return -1;
  1137.     }
  1138.  
  1139.   return 0;
  1140.  
  1141.  data_read_error:
  1142.   return -1;
  1143. }
  1144.  
  1145. // We don't just use a cast here, because we need to be able to detect
  1146. // possible errors.
  1147.  
  1148. static oct_mach_info::float_format
  1149. mopt_digit_to_float_format (int mach)
  1150. {
  1151.   oct_mach_info::float_format flt_fmt = oct_mach_info::unknown;
  1152.  
  1153.   switch (mach)
  1154.     {
  1155.     case 0:
  1156.       flt_fmt = oct_mach_info::ieee_little_endian;
  1157.       break;
  1158.  
  1159.     case 1:
  1160.       flt_fmt = oct_mach_info::ieee_big_endian;
  1161.       break;
  1162.  
  1163.     case 2:
  1164.       flt_fmt = oct_mach_info::vax_d;
  1165.       break;
  1166.  
  1167.     case 3:
  1168.       flt_fmt = oct_mach_info::vax_g;
  1169.       break;
  1170.  
  1171.     case 4:
  1172.       flt_fmt = oct_mach_info::cray;
  1173.       break;
  1174.  
  1175.     default:
  1176.       flt_fmt = oct_mach_info::unknown;
  1177.       break;
  1178.     }
  1179.  
  1180.   return flt_fmt;
  1181. }
  1182.  
  1183. static int
  1184. float_format_to_mopt_digit (oct_mach_info::float_format flt_fmt)
  1185. {
  1186.   int retval = -1;
  1187.  
  1188.   switch (flt_fmt)
  1189.     {
  1190.     case oct_mach_info::ieee_little_endian:
  1191.       retval = 0;
  1192.       break;
  1193.  
  1194.     case oct_mach_info::ieee_big_endian:
  1195.       retval = 1;
  1196.       break;
  1197.  
  1198.     case oct_mach_info::vax_d:
  1199.       retval = 2;
  1200.       break;
  1201.  
  1202.     case oct_mach_info::vax_g:
  1203.       retval = 3;
  1204.       break;
  1205.  
  1206.     case oct_mach_info::cray:
  1207.       retval = 4;
  1208.       break;
  1209.  
  1210.     default:
  1211.       break;
  1212.     }
  1213.  
  1214.   return retval;
  1215. }
  1216.  
  1217. // Extract one value (scalar, matrix, string, etc.) from stream IS and
  1218. // place it in TC, returning the name of the variable.
  1219. //
  1220. // The data is expected to be in Matlab's .mat format, though not all
  1221. // the features of that format are supported.
  1222. //
  1223. // FILENAME is used for error messages.
  1224. //
  1225. // This format provides no way to tag the data as global.
  1226.  
  1227. static char *
  1228. read_mat_binary_data (istream& is, const string& filename,
  1229.               octave_value& tc)
  1230. {
  1231.   // These are initialized here instead of closer to where they are
  1232.   // first used to avoid errors from gcc about goto crossing
  1233.   // initialization of variable.
  1234.  
  1235.   Matrix re;
  1236.   oct_mach_info::float_format flt_fmt = oct_mach_info::unknown;
  1237.   char *name = 0;
  1238.   int swap = 0, type = 0, prec = 0, mach = 0, dlen = 0;
  1239.  
  1240.   FOUR_BYTE_INT mopt, nr, nc, imag, len;
  1241.  
  1242.   int err = read_mat_file_header (is, swap, mopt, nr, nc, imag, len);
  1243.   if (err)
  1244.     {
  1245.       if (err < 0)
  1246.     goto data_read_error;
  1247.       else
  1248.     return 0;
  1249.     }
  1250.  
  1251.   type = mopt % 10; // Full, sparse, etc.
  1252.   mopt /= 10;       // Eliminate first digit.
  1253.   prec = mopt % 10; // double, float, int, etc.
  1254.   mopt /= 100;      // Skip unused third digit too.
  1255.   mach = mopt % 10; // IEEE, VAX, etc.
  1256.  
  1257.   flt_fmt = mopt_digit_to_float_format (mach);
  1258.  
  1259.   if (flt_fmt == oct_mach_info::unknown)
  1260.     {
  1261.       error ("load: unrecognized binary format!");
  1262.       return 0;
  1263.     }
  1264.  
  1265.   if (type != 0 && type != 1)
  1266.     {
  1267.       error ("load: can't read sparse matrices");
  1268.       return 0;
  1269.     }
  1270.  
  1271.   if (imag && type == 1)
  1272.     {
  1273.       error ("load: encountered complex matrix with string flag set!");
  1274.       return 0;
  1275.     }
  1276.  
  1277.   // LEN includes the terminating character, and the file is also
  1278.   // supposed to include it, but apparently not all files do.  Either
  1279.   // way, I think this should work.
  1280.  
  1281.   name = new char [len+1];
  1282.   if (! is.read (name, len))
  1283.     goto data_read_error;
  1284.   name[len] = '\0';
  1285.  
  1286.   dlen = nr * nc;
  1287.   if (dlen < 0)
  1288.     goto data_read_error;
  1289.  
  1290.   re.resize (nr, nc);
  1291.  
  1292.   read_mat_binary_data (is, re.fortran_vec (), prec, dlen, swap, flt_fmt);
  1293.  
  1294.   if (! is || error_state)
  1295.     {
  1296.       error ("load: reading matrix data for `%s'", name);
  1297.       goto data_read_error;
  1298.     }
  1299.  
  1300.   if (imag)
  1301.     {
  1302.       Matrix im (nr, nc);
  1303.  
  1304.       read_mat_binary_data (is, im.fortran_vec (), prec, dlen, swap, flt_fmt);
  1305.  
  1306.       if (! is || error_state)
  1307.     {
  1308.       error ("load: reading imaginary matrix data for `%s'", name);
  1309.       goto data_read_error;
  1310.     }
  1311.  
  1312.       ComplexMatrix ctmp (nr, nc);
  1313.  
  1314.       for (int j = 0; j < nc; j++)
  1315.     for (int i = 0; i < nr; i++)
  1316.       ctmp (i, j) = Complex (re (i, j), im (i, j));
  1317.  
  1318.       tc = ctmp;
  1319.     }
  1320.   else
  1321.     tc = re;
  1322.  
  1323.   if (type == 1)
  1324.     tc = tc.convert_to_str ();
  1325.  
  1326.   return name;
  1327.  
  1328.  data_read_error:
  1329.   error ("load: trouble reading binary file `%s'", filename.c_str ());
  1330.   delete [] name;
  1331.   return 0;
  1332. }
  1333.  
  1334. // Return nonzero if NAME matches one of the given globbing PATTERNS.
  1335.  
  1336. static int
  1337. matches_patterns (const string_vector& patterns, int pat_idx,
  1338.           int num_pat, const string& name)
  1339. {
  1340.   for (int i = pat_idx; i < num_pat; i++)
  1341.     {
  1342.       glob_match pattern (patterns[i]);
  1343.       if (pattern.match (name))
  1344.     return 1;
  1345.     }
  1346.   return 0;
  1347. }
  1348.  
  1349. static int
  1350. read_binary_file_header (istream& is, int& swap,
  1351.              oct_mach_info::float_format& flt_fmt,
  1352.              int quiet = 0) 
  1353. {
  1354.   int magic_len = 10;
  1355.   char magic [magic_len+1];
  1356.   is.read (magic, magic_len);
  1357.   magic[magic_len] = '\0';
  1358.   if (strncmp (magic, "Octave-1-L", magic_len) == 0)
  1359.     swap = oct_mach_info::words_big_endian ();
  1360.   else if (strncmp (magic, "Octave-1-B", magic_len) == 0)
  1361.     swap = ! oct_mach_info::words_big_endian ();
  1362.   else
  1363.     {
  1364.       if (! quiet)
  1365.     error ("load: can't read binary file");
  1366.       return -1;
  1367.     }
  1368.     
  1369.   char tmp = 0;
  1370.   is.read (&tmp, 1);
  1371.  
  1372.   flt_fmt = mopt_digit_to_float_format (tmp);
  1373.  
  1374.   if (flt_fmt == oct_mach_info::unknown)
  1375.     {
  1376.       if (! quiet)
  1377.         error ("load: unrecognized binary format!");
  1378.       return -1;
  1379.     }
  1380.  
  1381.   return 0;
  1382. }
  1383.  
  1384. static load_save_format
  1385. get_file_format (const string& fname, const string& orig_fname)
  1386. {
  1387.   load_save_format retval = LS_UNKNOWN;
  1388.  
  1389.   ifstream file (fname.c_str ());
  1390.  
  1391.   if (! file)
  1392.     {
  1393.       error ("load: couldn't open input file `%s'", orig_fname.c_str ());
  1394.       return retval;
  1395.     }
  1396.  
  1397.   int swap;
  1398.   oct_mach_info::float_format flt_fmt = oct_mach_info::unknown;
  1399.  
  1400.   if (read_binary_file_header (file, swap, flt_fmt, 1) == 0)
  1401.     retval = LS_BINARY;
  1402.   else
  1403.     {
  1404.       file.seekg (0, ios::beg);
  1405.  
  1406.       FOUR_BYTE_INT mopt, nr, nc, imag, len;
  1407.  
  1408.       int err = read_mat_file_header (file, swap, mopt, nr, nc, imag, len, 1);
  1409.  
  1410.       if (! err)
  1411.     retval = LS_MAT_BINARY;
  1412.       else
  1413.     {
  1414.       file.clear ();
  1415.       file.seekg (0, ios::beg);
  1416.  
  1417.       char *tmp = extract_keyword (file, "name");
  1418.  
  1419.       if (tmp)
  1420.         {
  1421.           retval = LS_ASCII;
  1422.  
  1423.           delete [] tmp;
  1424.         }
  1425.       else
  1426.         {
  1427.           // Try reading the file as numbers only, determining the
  1428.           // number of rows and columns from the data.  We don't
  1429.           // even bother to check to see if the first item in the
  1430.           // file is a number, so that get_complete_line() can
  1431.           // skip any comments that might appear at the top of the
  1432.           // file.
  1433.  
  1434.           retval = LS_MAT_ASCII;
  1435.         }
  1436.     }
  1437.     }
  1438.  
  1439.   file.close ();
  1440.  
  1441.   if (retval == LS_UNKNOWN)
  1442.     error ("load: unable to determine file format for `%s'",
  1443.        orig_fname.c_str ());
  1444.  
  1445.   return retval;
  1446. }
  1447.  
  1448. static octave_value_list
  1449. do_load (istream& stream, const string& orig_fname, int force,
  1450.      load_save_format format, oct_mach_info::float_format flt_fmt,
  1451.      int list_only, int swap, int verbose, const string_vector& argv,
  1452.      int argv_idx, int argc, int nargout)
  1453. {
  1454.   octave_value_list retval;
  1455.  
  1456.   ostrstream output_buf;
  1457.   int count = 0;
  1458.   for (;;)
  1459.     {
  1460.       int global = 0;
  1461.       octave_value tc;
  1462.  
  1463.       char *name = 0;
  1464.       char *doc = 0;
  1465.  
  1466.       switch (format)
  1467.     {
  1468.     case LS_ASCII:
  1469.       name = read_ascii_data (stream, orig_fname, global, tc);
  1470.       break;
  1471.  
  1472.     case LS_BINARY:
  1473.       name = read_binary_data (stream, swap, flt_fmt, orig_fname,
  1474.                    global, tc, doc);
  1475.       break;
  1476.  
  1477.     case LS_MAT_ASCII:
  1478.       name = read_mat_ascii_data (stream, orig_fname, tc);
  1479.       break;
  1480.  
  1481.     case LS_MAT_BINARY:
  1482.       name = read_mat_binary_data (stream, orig_fname, tc);
  1483.       break;
  1484.  
  1485.     default:
  1486.       gripe_unrecognized_data_fmt ("load");
  1487.       break;
  1488.     }
  1489.  
  1490.       if (error_state || stream.eof () || ! name)
  1491.     {
  1492.       delete [] name;
  1493.       delete [] doc;
  1494.  
  1495.       break;
  1496.     }
  1497.       else if (! error_state && name)
  1498.     {
  1499.       if (tc.is_defined ())
  1500.         {
  1501.           if (argv_idx == argc
  1502.           || matches_patterns (argv, argv_idx, argc, name))
  1503.         {
  1504.           count++;
  1505.           if (list_only)
  1506.             {
  1507.               if (verbose)
  1508.             {
  1509.               if (count == 1)
  1510.                 output_buf
  1511.                   << "type               rows   cols   name\n"
  1512.                   << "====               ====   ====   ====\n";
  1513.  
  1514.               string type = tc.type_name ();
  1515.               output_buf.form ("%-16s", type.c_str ());
  1516.               output_buf.form ("%7d", tc.rows ());
  1517.               output_buf.form ("%7d", tc.columns ());
  1518.               output_buf << "   ";
  1519.             }
  1520.               output_buf << name << "\n";
  1521.             }
  1522.           else
  1523.             {
  1524.               install_loaded_variable (force, name, tc, global, doc);
  1525.             }
  1526.         }
  1527.  
  1528.           delete [] name;
  1529.           delete [] doc;
  1530.  
  1531.           // Only attempt to read one item from a headless text file.
  1532.  
  1533.           if (format == LS_MAT_ASCII)
  1534.         break;
  1535.         }
  1536.       else
  1537.         error ("load: unable to load variable `%s'", name);
  1538.     }
  1539.       else
  1540.     {
  1541.       if (count == 0)
  1542.         error ("load: are you sure `%s' is an Octave data file?",
  1543.            orig_fname.c_str ());
  1544.  
  1545.       delete [] name;
  1546.       delete [] doc;
  1547.  
  1548.       break;
  1549.     }
  1550.     }
  1551.  
  1552.   if (list_only && count)
  1553.     {
  1554.       output_buf << ends;
  1555.  
  1556.       char *msg = output_buf.str ();
  1557.  
  1558.       if (nargout > 0)
  1559.     retval = msg;
  1560.       else
  1561.     octave_stdout << msg;
  1562.  
  1563.       delete [] msg;
  1564.     }
  1565.  
  1566.   return retval;
  1567. }
  1568.  
  1569. DEFUN_TEXT (load, args, nargout,
  1570.   "load [-force] [-ascii] [-binary] [-mat-binary] file [pattern ...]\n\
  1571. \n\
  1572. Load variables from a file.\n\
  1573. \n\
  1574. If no argument is supplied to select a format, load tries to read the\n\
  1575. named file as an Octave binary, then as a .mat file, and then as an\n\
  1576. Octave text file.\n\
  1577. \n\
  1578. If the option -force is given, variables with the same names as those\n\
  1579. found in the file will be replaced with the values read from the file.")
  1580. {
  1581.   octave_value_list retval;
  1582.  
  1583.   int argc = args.length () + 1;
  1584.  
  1585.   string_vector argv = args.make_argv ("load");
  1586.  
  1587.   if (error_state)
  1588.     return retval;
  1589.  
  1590.   int force = 0;
  1591.  
  1592.   // It isn't necessary to have the default load format stored in a
  1593.   // user preference variable since we can determine the type of file
  1594.   // as we are reading.
  1595.  
  1596.   load_save_format format = LS_UNKNOWN;
  1597.  
  1598.   int list_only = 0;
  1599.   int verbose = 0;
  1600.  
  1601.   int i;
  1602.   for (i = 1; i < argc; i++)
  1603.     {
  1604.       if (argv[i] == "-force" || argv[i] == "-f")
  1605.     {
  1606.       force++;
  1607.     }
  1608.       else if (argv[i] == "-list" || argv[i] == "-l")
  1609.     {
  1610.       list_only = 1;
  1611.     }
  1612.       else if (argv[i] == "-verbose" || argv[i] == "-v")
  1613.     {
  1614.       verbose = 1;
  1615.     }
  1616.       else if (argv[i] == "-ascii" || argv[i] == "-a")
  1617.     {
  1618.       format = LS_ASCII;
  1619.     }
  1620.       else if (argv[i] == "-binary" || argv[i] == "-b")
  1621.     {
  1622.       format = LS_BINARY;
  1623.     }
  1624.       else if (argv[i] == "-mat-binary" || argv[i] == "-m")
  1625.     {
  1626.       format = LS_MAT_BINARY;
  1627.     }
  1628.       else
  1629.     break;
  1630.     }
  1631.  
  1632.   if (i == argc)
  1633.     {
  1634.       print_usage ("load");
  1635.       return retval;
  1636.     }
  1637.  
  1638.   string orig_fname = argv[i];
  1639.  
  1640.   oct_mach_info::float_format flt_fmt = oct_mach_info::unknown;
  1641.  
  1642.   int swap = 0;
  1643.  
  1644.   if (argv[i] == "-")
  1645.     {
  1646.       i++;
  1647.  
  1648.       if (format != LS_UNKNOWN)
  1649.     {
  1650.       // XXX FIXME XXX -- if we have already seen EOF on a
  1651.       // previous call, how do we fix up the state of cin so that
  1652.       // we can get additional input?  I'm afraid that we can't
  1653.       // fix this using cin only.
  1654.  
  1655.       retval = do_load (cin, orig_fname, force, format, flt_fmt,
  1656.                 list_only, swap, verbose, argv, i, argc,
  1657.                 nargout);
  1658.     }
  1659.       else
  1660.     error ("load: must specify file format if reading from stdin");
  1661.     }
  1662.   else
  1663.     {
  1664.       string fname = oct_tilde_expand (argv[i]);
  1665.  
  1666.       if (format == LS_UNKNOWN)
  1667.     format = get_file_format (fname, orig_fname);
  1668.  
  1669.       if (format != LS_UNKNOWN)
  1670.     {
  1671.       i++;
  1672.  
  1673.       unsigned mode = ios::in;
  1674.       if (format == LS_BINARY || format == LS_MAT_BINARY)
  1675.         mode |= ios::bin;
  1676.  
  1677.       ifstream file (fname.c_str (), mode);
  1678.  
  1679.       if (file)
  1680.         {
  1681.           if (format == LS_BINARY)
  1682.         {
  1683.           if (read_binary_file_header (file, swap, flt_fmt) < 0)
  1684.             {
  1685.               file.close ();
  1686.               return retval;
  1687.             }
  1688.         }
  1689.  
  1690.           retval = do_load (file, orig_fname, force, format,
  1691.                 flt_fmt, list_only, swap, verbose,
  1692.                 argv, i, argc, nargout);
  1693.  
  1694.           file.close ();
  1695.         }
  1696.       else
  1697.         error ("load: couldn't open input file `%s'",
  1698.            orig_fname.c_str ());
  1699.     }
  1700.     }
  1701.  
  1702.   return retval;
  1703. }
  1704.  
  1705. // Return nonzero if PATTERN has any special globbing chars in it.
  1706.  
  1707. static int
  1708. glob_pattern_p (const string& pattern)
  1709. {
  1710.   int open = 0;
  1711.  
  1712.   int len = pattern.length ();
  1713.  
  1714.   for (int i = 0; i < len; i++)
  1715.     {
  1716.       char c = pattern[i];
  1717.  
  1718.       switch (c)
  1719.     {
  1720.     case '?':
  1721.     case '*':
  1722.       return 1;
  1723.  
  1724.     case '[':    // Only accept an open brace if there is a close
  1725.       open++;    // brace to match it.  Bracket expressions must be
  1726.       continue;    // complete, according to Posix.2
  1727.  
  1728.     case ']':
  1729.       if (open)
  1730.         return 1;
  1731.       continue;
  1732.       
  1733.     case '\\':
  1734.       if (i == len - 1)
  1735.         return 0;
  1736.  
  1737.     default:
  1738.       continue;
  1739.     }
  1740.     }
  1741.  
  1742.   return 0;
  1743. }
  1744.  
  1745. // MAX_VAL and MIN_VAL are assumed to have integral values even though
  1746. // they are stored in doubles.
  1747.  
  1748. static save_type
  1749. get_save_type (double max_val, double min_val)
  1750. {
  1751.   save_type st = LS_DOUBLE;
  1752.  
  1753.   if (max_val < 256 && min_val > -1)
  1754.     st = LS_U_CHAR;
  1755.   else if (max_val < 65536 && min_val > -1)
  1756.     st = LS_U_SHORT;
  1757.   else if (max_val < 4294967295 && min_val > -1)
  1758.     st = LS_U_INT;
  1759.   else if (max_val < 128 && min_val >= -128)
  1760.     st = LS_CHAR;
  1761.   else if (max_val < 32768 && min_val >= -32768)
  1762.     st = LS_SHORT;
  1763.   else if (max_val < 2147483648 && min_val > -2147483648)
  1764.     st = LS_INT;
  1765.  
  1766.   return st;
  1767. }
  1768.  
  1769. // Save the data from TC along with the corresponding NAME, help
  1770. // string DOC, and global flag MARK_AS_GLOBAL on stream OS in the
  1771. // binary format described above for read_binary_data.
  1772.  
  1773. static int
  1774. save_binary_data (ostream& os, const octave_value& tc,
  1775.           const string& name, const string& doc,
  1776.           int mark_as_global, int save_as_floats) 
  1777. {
  1778.   int fail = 0;
  1779.  
  1780.   FOUR_BYTE_INT name_len = name.length ();
  1781.  
  1782.   os.write (&name_len, 4);
  1783.   os << name;
  1784.  
  1785.   FOUR_BYTE_INT doc_len = doc.length ();
  1786.  
  1787.   os.write (&doc_len, 4);
  1788.   os << doc;
  1789.  
  1790.   char tmp;
  1791.  
  1792.   tmp = mark_as_global;
  1793.   os.write (&tmp, 1);
  1794.  
  1795.   if (tc.is_real_scalar ())
  1796.     {
  1797.       tmp = 1;
  1798.       os.write (&tmp, 1);
  1799.       tmp = (char) LS_DOUBLE;
  1800.       os.write (&tmp, 1);
  1801.       double tmp = tc.double_value ();
  1802.       os.write (&tmp, 8);
  1803.     }
  1804.   else if (tc.is_real_matrix ())
  1805.     {
  1806.       tmp = 2;
  1807.       os.write (&tmp, 1);
  1808.       Matrix m = tc.matrix_value ();
  1809.       FOUR_BYTE_INT nr = m.rows ();
  1810.       FOUR_BYTE_INT nc = m.columns ();
  1811.       os.write (&nr, 4);
  1812.       os.write (&nc, 4);
  1813.       int len = nr * nc;
  1814.       save_type st = LS_DOUBLE;
  1815.       if (save_as_floats)
  1816.     {
  1817.       if (m.too_large_for_float ())
  1818.         {
  1819.           warning ("save: some values too large to save as floats --");
  1820.           warning ("save: saving as doubles instead");
  1821.         }
  1822.       else
  1823.         st = LS_FLOAT;
  1824.     }
  1825.       else if (len > 8192) // XXX FIXME XXX -- make this configurable.
  1826.     {
  1827.       double max_val, min_val;
  1828.       if (m.all_integers (max_val, min_val))
  1829.         st = get_save_type (max_val, min_val);
  1830.     }
  1831.       const double *mtmp = m.data ();
  1832.       write_doubles (os, mtmp, st, len);
  1833.     }
  1834.   else if (tc.is_complex_scalar ())
  1835.     {
  1836.       tmp = 3;
  1837.       os.write (&tmp, 1);
  1838.       tmp = (char) LS_DOUBLE;
  1839.       os.write (&tmp, 1);
  1840.       Complex tmp = tc.complex_value ();
  1841.       os.write (&tmp, 16);
  1842.     }
  1843.   else if (tc.is_complex_matrix ())
  1844.     {
  1845.       tmp = 4;
  1846.       os.write (&tmp, 1);
  1847.       ComplexMatrix m = tc.complex_matrix_value ();
  1848.       FOUR_BYTE_INT nr = m.rows ();
  1849.       FOUR_BYTE_INT nc = m.columns ();
  1850.       os.write (&nr, 4);
  1851.       os.write (&nc, 4);
  1852.       int len = nr * nc;
  1853.       save_type st = LS_DOUBLE;
  1854.       if (save_as_floats)
  1855.     {
  1856.       if (m.too_large_for_float ())
  1857.         {
  1858.           warning ("save: some values too large to save as floats --");
  1859.           warning ("save: saving as doubles instead");
  1860.         }
  1861.       else
  1862.         st = LS_FLOAT;
  1863.     }
  1864.       else if (len > 4096) // XXX FIXME XXX -- make this configurable.
  1865.     {
  1866.       double max_val, min_val;
  1867.       if (m.all_integers (max_val, min_val))
  1868.         st = get_save_type (max_val, min_val);
  1869.     }
  1870.       const Complex *mtmp = m.data ();
  1871.       write_doubles (os, (const double *) mtmp, st, 2*len);
  1872.     }
  1873.   else if (tc.is_string ())
  1874.     {
  1875.       tmp = 7;
  1876.       os.write (&tmp, 1);
  1877.       FOUR_BYTE_INT nr = tc.rows ();
  1878.       os.write (&nr, 4);
  1879.       charMatrix chm = tc.char_matrix_value ();
  1880.       for (int i = 0; i < nr; i++)
  1881.     {
  1882.       FOUR_BYTE_INT len = chm.cols ();
  1883.       os.write (&len, 4);
  1884.       string tstr = chm.row_as_string (i);
  1885.       const char *tmp = tstr.data ();
  1886.       os.write (tmp, len);
  1887.     }
  1888.     }
  1889.   else if (tc.is_range ())
  1890.     {
  1891.       tmp = 6;
  1892.       os.write (&tmp, 1);
  1893.       tmp = (char) LS_DOUBLE;
  1894.       os.write (&tmp, 1);
  1895.       Range r = tc.range_value ();
  1896.       double bas = r.base ();
  1897.       double lim = r.limit ();
  1898.       double inc = r.inc ();
  1899.       os.write (&bas, 8);
  1900.       os.write (&lim, 8);
  1901.       os.write (&inc, 8);
  1902.     }
  1903.   else
  1904.     {
  1905.       gripe_wrong_type_arg ("save", tc);
  1906.       fail = 1;
  1907.     }
  1908.  
  1909.   return (os && ! fail);
  1910. }
  1911.  
  1912. // Save the data from TC along with the corresponding NAME on stream OS 
  1913. // in the MatLab binary format.
  1914.  
  1915. static int
  1916. save_mat_binary_data (ostream& os, const octave_value& tc,
  1917.               const string& name) 
  1918. {
  1919.   int fail = 0;
  1920.  
  1921.   FOUR_BYTE_INT mopt = 0;
  1922.  
  1923.   mopt += tc.is_string () ? 1 : 0;
  1924.  
  1925.   oct_mach_info::float_format flt_fmt =
  1926.     oct_mach_info::native_float_format ();;
  1927.  
  1928.   mopt += 1000 * float_format_to_mopt_digit (flt_fmt);
  1929.  
  1930.   os.write (&mopt, 4);
  1931.   
  1932.   FOUR_BYTE_INT nr = tc.rows ();
  1933.   os.write (&nr, 4);
  1934.  
  1935.   FOUR_BYTE_INT nc = tc.columns ();
  1936.   os.write (&nc, 4);
  1937.  
  1938.   int len = nr * nc;
  1939.  
  1940.   FOUR_BYTE_INT imag = tc.is_complex_type () ? 1 : 0;
  1941.   os.write (&imag, 4);
  1942.  
  1943.   // LEN includes the terminating character, and the file is also
  1944.   // supposed to include it.
  1945.  
  1946.   FOUR_BYTE_INT name_len = name.length () + 1;
  1947.  
  1948.   os.write (&name_len, 4);
  1949.   os << name << '\0';
  1950.  
  1951.   if (tc.is_real_scalar ())
  1952.     {
  1953.       double tmp = tc.double_value ();
  1954.       os.write (&tmp, 8);
  1955.     }
  1956.   else if (tc.is_real_matrix ())
  1957.     {
  1958.       Matrix m = tc.matrix_value ();
  1959.       os.write (m.data (), 8 * len);
  1960.     }
  1961.   else if (tc.is_complex_scalar ())
  1962.     {
  1963.       Complex tmp = tc.complex_value ();
  1964.       os.write (&tmp, 16);
  1965.     }
  1966.   else if (tc.is_complex_matrix ())
  1967.     {
  1968.       ComplexMatrix m_cmplx = tc.complex_matrix_value ();
  1969.       Matrix m = ::real(m_cmplx);
  1970.       os.write (m.data (), 8 * len);
  1971.       m = ::imag(m_cmplx);
  1972.       os.write (m.data (), 8 * len);
  1973.     }
  1974.   else if (tc.is_string ())
  1975.     {
  1976.       begin_unwind_frame ("save_mat_binary_data");
  1977.       unwind_protect_int (Vimplicit_str_to_num_ok);
  1978.       Vimplicit_str_to_num_ok = 1;
  1979.       Matrix m = tc.matrix_value ();
  1980.       os.write (m.data (), 8 * len);
  1981.       run_unwind_frame ("save_mat_binary_data");
  1982.     }
  1983.   else if (tc.is_range ())
  1984.     {
  1985.       Range r = tc.range_value ();
  1986.       double base = r.base ();
  1987.       double inc = r.inc ();
  1988.       int nel = r.nelem ();
  1989.       for (int i = 0; i < nel; i++)
  1990.     {
  1991.       double x = base + i * inc;
  1992.       os.write (&x, 8);
  1993.     }
  1994.     }
  1995.   else
  1996.     {
  1997.       gripe_wrong_type_arg ("save", tc);
  1998.       fail = 1;
  1999.     }
  2000.  
  2001.   return (os && ! fail);
  2002. }
  2003.  
  2004. static void
  2005. ascii_save_type (ostream& os, char *type, int mark_as_global)
  2006. {
  2007.   if (mark_as_global)
  2008.     os << "# type: global ";
  2009.   else
  2010.     os << "# type: ";
  2011.  
  2012.   os << type << "\n";
  2013. }
  2014.  
  2015. static Matrix
  2016. strip_infnan (const Matrix& m)
  2017. {
  2018.   int nr = m.rows ();
  2019.   int nc = m.columns ();
  2020.  
  2021.   Matrix retval (nr, nc);
  2022.  
  2023.   int k = 0;
  2024.   for (int i = 0; i < nr; i++)
  2025.     {
  2026.       for (int j = 0; j < nc; j++)
  2027.     {
  2028.       double d = m (i, j);
  2029.       if (xisnan (d))
  2030.         goto next_row;
  2031.       else
  2032.         retval (k, j) = xisinf (d) ? (d > 0 ? OCT_RBV : -OCT_RBV) : d;
  2033.     }
  2034.       k++;
  2035.  
  2036.     next_row:
  2037.       continue;
  2038.     }
  2039.  
  2040.   if (k > 0)
  2041.     retval.resize (k, nc);
  2042.  
  2043.   return retval;
  2044. }
  2045.  
  2046. static ComplexMatrix
  2047. strip_infnan (const ComplexMatrix& m)
  2048. {
  2049.   int nr = m.rows ();
  2050.   int nc = m.columns ();
  2051.  
  2052.   ComplexMatrix retval (nr, nc);
  2053.  
  2054.   int k = 0;
  2055.   for (int i = 0; i < nr; i++)
  2056.     {
  2057.       for (int j = 0; j < nc; j++)
  2058.     {
  2059.       Complex c = m (i, j);
  2060.       if (xisnan (c))
  2061.         goto next_row;
  2062.       else
  2063.         {
  2064.           double re = real (c);
  2065.           double im = imag (c);
  2066.  
  2067.           re = xisinf (re) ? (re > 0 ? OCT_RBV : -OCT_RBV) : re;
  2068.           im = xisinf (im) ? (im > 0 ? OCT_RBV : -OCT_RBV) : im;
  2069.  
  2070.           retval (k, j) = Complex (re, im);
  2071.         }
  2072.     }
  2073.       k++;
  2074.  
  2075.     next_row:
  2076.       continue;
  2077.     }
  2078.  
  2079.   if (k > 0)
  2080.     retval.resize (k, nc);
  2081.  
  2082.   return retval;
  2083. }
  2084.  
  2085. // Save the data from TC along with the corresponding NAME, and global
  2086. // flag MARK_AS_GLOBAL on stream OS in the plain text format described
  2087. // above for load_ascii_data.  If NAME is empty, the name: line is not
  2088. // generated.  PRECISION specifies the number of decimal digits to print. 
  2089. // If STRIP_NAN_AND_INF is nonzero, rows containing NaNs are deleted,
  2090. // and Infinite values are converted to +/-OCT_RBV (A Real Big Value,
  2091. // but not so big that gnuplot can't handle it when trying to compute
  2092. // axis ranges, etc.).
  2093. //
  2094. // Assumes ranges and strings cannot contain Inf or NaN values.
  2095. //
  2096. // Returns 1 for success and 0 for failure.
  2097.  
  2098. // XXX FIXME XXX -- should probably write the help string here too.
  2099.  
  2100. int
  2101. save_ascii_data (ostream& os, const octave_value& tc,
  2102.          const string& name, int strip_nan_and_inf,
  2103.          int mark_as_global, int precision) 
  2104. {
  2105.   int success = 1;
  2106.  
  2107.   if (! precision)
  2108.     precision = Vsave_precision;
  2109.  
  2110.   if (! name.empty ())
  2111.     os << "# name: " << name << "\n";
  2112.  
  2113.   long old_precision = os.precision ();
  2114.   os.precision (precision);
  2115.  
  2116.   if (tc.is_real_scalar ())
  2117.     {
  2118.       ascii_save_type (os, "scalar", mark_as_global);
  2119.  
  2120.       double d = tc.double_value ();
  2121.       if (strip_nan_and_inf)
  2122.     {
  2123.       if (xisnan (d))
  2124.         {
  2125.           error ("only value to plot is NaN");
  2126.           success = 0;
  2127.         }
  2128.       else
  2129.         {
  2130.           d = xisinf (d) ? (d > 0 ? OCT_RBV : -OCT_RBV) : d;
  2131.           os << d << "\n";
  2132.         }
  2133.     }
  2134.       else
  2135.     os << d << "\n";
  2136.     }
  2137.   else if (tc.is_real_matrix ())
  2138.     {
  2139.       ascii_save_type (os, "matrix", mark_as_global);
  2140.       os << "# rows: " << tc.rows () << "\n"
  2141.      << "# columns: " << tc.columns () << "\n";
  2142.  
  2143.       Matrix tmp = tc.matrix_value ();
  2144.       if (strip_nan_and_inf)
  2145.     tmp = strip_infnan (tmp);
  2146.  
  2147.       os << tmp;
  2148.     }
  2149.   else if (tc.is_complex_scalar ())
  2150.     {
  2151.       ascii_save_type (os, "complex scalar", mark_as_global);
  2152.  
  2153.       Complex c = tc.complex_value ();
  2154.       if (strip_nan_and_inf)
  2155.     {
  2156.       if (xisnan (c))
  2157.         {
  2158.           error ("only value to plot is NaN");
  2159.           success = 0;
  2160.         }
  2161.       else
  2162.         {
  2163.           double re = real (c);
  2164.           double im = imag (c);
  2165.  
  2166.           re = xisinf (re) ? (re > 0 ? OCT_RBV : -OCT_RBV) : re;
  2167.           im = xisinf (im) ? (im > 0 ? OCT_RBV : -OCT_RBV) : im;
  2168.  
  2169.           c = Complex (re, im);
  2170.  
  2171.           os << c << "\n";
  2172.         }
  2173.     }
  2174.       else
  2175.     os << c << "\n";
  2176.     }
  2177.   else if (tc.is_complex_matrix ())
  2178.     {
  2179.       ascii_save_type (os, "complex matrix", mark_as_global);
  2180.       os << "# rows: " << tc.rows () << "\n"
  2181.      << "# columns: " << tc.columns () << "\n";
  2182.  
  2183.       ComplexMatrix tmp = tc.complex_matrix_value ();
  2184.       if (strip_nan_and_inf)
  2185.     tmp = strip_infnan (tmp);
  2186.  
  2187.       os << tmp;
  2188.     }
  2189.   else if (tc.is_string ())
  2190.     {
  2191.       ascii_save_type (os, "string array", mark_as_global);
  2192.       charMatrix chm = tc.char_matrix_value ();
  2193.       int elements = chm.rows ();
  2194.       os << "# elements: " << elements << "\n";
  2195.       for (int i = 0; i < elements; i++)
  2196.     {
  2197.       int len = chm.cols ();
  2198.       os << "# length: " << len << "\n";
  2199.       string tstr = chm.row_as_string (i);
  2200.       const char *tmp = tstr.data ();
  2201.       os.write (tmp, len);
  2202.       os << "\n";
  2203.     }
  2204.     }
  2205.   else if (tc.is_range ())
  2206.     {
  2207.       ascii_save_type (os, "range", mark_as_global);
  2208.       Range tmp = tc.range_value ();
  2209.       os << "# base, limit, increment\n"
  2210.      << tmp.base () << " "
  2211.      << tmp.limit () << " "
  2212.      << tmp.inc () << "\n";
  2213.     }
  2214.   else
  2215.     {
  2216.       gripe_wrong_type_arg ("save", tc);
  2217.       success = 0;
  2218.     }
  2219.  
  2220.   os.precision (old_precision);
  2221.  
  2222.   return (os && success);
  2223. }
  2224.  
  2225. // Save the info from sr on stream os in the format specified by fmt.
  2226.  
  2227. static void
  2228. do_save (ostream& os, symbol_record *sr, load_save_format fmt,
  2229.      int save_as_floats)
  2230. {
  2231.   if (! sr->is_variable ())
  2232.     {
  2233.       error ("save: can only save variables, not functions");
  2234.       return;
  2235.     }
  2236.  
  2237.   string name = sr->name ();
  2238.   string help = sr->help ();
  2239.   int global = sr->is_linked_to_global ();
  2240.   tree_fvc *tmp = sr->def ();
  2241.   octave_value tc = tmp->eval (0);
  2242.  
  2243.   if (tc.is_undefined ())
  2244.     return;
  2245.  
  2246.   switch (fmt)
  2247.     {
  2248.     case LS_ASCII:
  2249.       save_ascii_data (os, tc, name, 0, global);
  2250.       break;
  2251.  
  2252.     case LS_BINARY:
  2253.       save_binary_data (os, tc, name, help, global, save_as_floats);
  2254.       break;
  2255.  
  2256.     case LS_MAT_BINARY:
  2257.       save_mat_binary_data (os, tc, name);
  2258.       break;
  2259.  
  2260.     default:
  2261.       gripe_unrecognized_data_fmt ("save");
  2262.       break;
  2263.     }
  2264. }
  2265.  
  2266. // Save variables with names matching PATTERN on stream OS in the
  2267. // format specified by FMT.  If SAVE_BUILTINS is nonzero, also save
  2268. // builtin variables with names that match PATTERN.
  2269.  
  2270. static int
  2271. save_vars (ostream& os, const string& pattern, int save_builtins,
  2272.        load_save_format fmt, int save_as_floats)
  2273. {
  2274.   int count;
  2275.  
  2276.   symbol_record **vars = curr_sym_tab->glob
  2277.     (count, pattern, symbol_def::USER_VARIABLE, SYMTAB_ALL_SCOPES);
  2278.  
  2279.   int saved = count;
  2280.  
  2281.   int i;
  2282.  
  2283.   for (i = 0; i < count; i++)
  2284.     {
  2285.       do_save (os, vars[i], fmt, save_as_floats);
  2286.  
  2287.       if (error_state)
  2288.     break;
  2289.     }
  2290.  
  2291.   delete [] vars;
  2292.  
  2293.   if (! error_state && save_builtins)
  2294.     {
  2295.       symbol_record **vars = global_sym_tab->glob
  2296.     (count, pattern, symbol_def::BUILTIN_VARIABLE, SYMTAB_ALL_SCOPES);
  2297.  
  2298.       saved += count;
  2299.  
  2300.       for (i = 0; i < count; i++)
  2301.     {
  2302.       do_save (os, vars[i], fmt, save_as_floats);
  2303.  
  2304.       if (error_state)
  2305.         break;
  2306.     }
  2307.  
  2308.       delete [] vars;
  2309.     }
  2310.  
  2311.   return saved;
  2312. }
  2313.  
  2314. static load_save_format
  2315. get_default_save_format (void)
  2316. {
  2317.   load_save_format retval = LS_ASCII;
  2318.  
  2319.   string fmt = Vdefault_save_format;
  2320.  
  2321.   if (fmt == "binary")
  2322.     retval = LS_BINARY;
  2323.   else if (fmt == "mat-binary" || fmt =="mat_binary")
  2324.     retval = LS_MAT_BINARY;
  2325.       
  2326.   return retval;
  2327. }
  2328.  
  2329. static void
  2330. write_binary_header (ostream& os, load_save_format format)
  2331. {
  2332.   if (format == LS_BINARY)
  2333.     {
  2334.       os << (oct_mach_info::words_big_endian ()
  2335.          ? "Octave-1-B" : "Octave-1-L");
  2336.  
  2337.       oct_mach_info::float_format flt_fmt =
  2338.     oct_mach_info::native_float_format ();
  2339.  
  2340.       char tmp = (char) float_format_to_mopt_digit (flt_fmt);
  2341.  
  2342.       os.write (&tmp, 1);
  2343.     }
  2344. }
  2345.  
  2346. static void
  2347. save_vars (const string_vector& argv, int argv_idx, int argc,
  2348.        ostream& os, int save_builtins, load_save_format fmt,
  2349.        int save_as_floats) 
  2350. {
  2351.   write_binary_header (os, fmt);
  2352.  
  2353.   if (argv_idx == argc)
  2354.     {
  2355.       save_vars (os, "*", save_builtins, fmt, save_as_floats);
  2356.     }
  2357.   else
  2358.     {
  2359.       for (int i = argv_idx; i < argc; i++)
  2360.     {
  2361.       if (! save_vars (os, argv[i], save_builtins, fmt, save_as_floats))
  2362.         {
  2363.           warning ("save: no such variable `%s'", argv[i].c_str ());
  2364.         }
  2365.     }
  2366.     }
  2367. }
  2368.  
  2369. void
  2370. save_user_variables (void)
  2371. {
  2372.   // XXX FIXME XXX -- should choose better file name?
  2373.  
  2374.   const char *fname = "octave-core";
  2375.  
  2376.   message (0, "attempting to save variables to `%s'...", fname);
  2377.  
  2378.   load_save_format format = get_default_save_format ();
  2379.  
  2380.   unsigned mode = ios::out|ios::trunc;
  2381.   if (format == LS_BINARY || format == LS_MAT_BINARY)
  2382.     mode |= ios::bin;
  2383.  
  2384.   ofstream file (fname, mode);
  2385.  
  2386.   if (file)
  2387.     {
  2388.       save_vars (string_vector (), 0, 0, file, 0, format, 0);
  2389.       message (0, "save to `%s' complete", fname);
  2390.     }
  2391.   else
  2392.     warning ("unable to open `%s' for writing...", fname);
  2393. }
  2394.  
  2395. DEFUN_TEXT (save, args, ,
  2396.   "save [-ascii] [-binary] [-float-binary] [-mat-binary] \n\
  2397.      [-save-builtins] file [pattern ...]\n\
  2398. \n\
  2399. save variables in a file")
  2400. {
  2401.   octave_value_list retval;
  2402.  
  2403.   int argc = args.length () + 1;
  2404.  
  2405.   string_vector argv = args.make_argv ("save");
  2406.  
  2407.   if (error_state)
  2408.     return retval;
  2409.  
  2410.   // Here is where we would get the default save format if it were
  2411.   // stored in a user preference variable.
  2412.  
  2413.   int save_builtins = 0;
  2414.  
  2415.   int save_as_floats = 0;
  2416.  
  2417.   load_save_format format = get_default_save_format ();
  2418.  
  2419.   int i;
  2420.   for (i = 1; i < argc; i++)
  2421.     {
  2422.       if (argv[i] == "-ascii" || argv[i] == "-a")
  2423.     {
  2424.       format = LS_ASCII;
  2425.     }
  2426.       else if (argv[i] == "-binary" || argv[i] == "-b")
  2427.     {
  2428.       format = LS_BINARY;
  2429.     }
  2430.       else if (argv[i] == "-mat-binary" || argv[i] == "-m")
  2431.     {
  2432.       format = LS_MAT_BINARY;
  2433.     }
  2434.       else if (argv[i] == "-float-binary" || argv[i] == "-f")
  2435.     {
  2436.       format = LS_BINARY;
  2437.       save_as_floats = 1;
  2438.     }
  2439.       else if (argv[i] == "-save-builtins")
  2440.     {
  2441.       save_builtins = 1;
  2442.     }
  2443.       else
  2444.     break;
  2445.     }
  2446.  
  2447.   if (i == argc)
  2448.     {
  2449.       print_usage ("save");
  2450.       return retval;
  2451.     }
  2452.  
  2453.   if (save_as_floats && format == LS_ASCII)
  2454.     {
  2455.       error ("save: cannot specify both -ascii and -float-binary");
  2456.       return retval;
  2457.     }
  2458.  
  2459.   if (argv[i] == "-")
  2460.     {
  2461.       i++;
  2462.  
  2463.       // XXX FIXME XXX -- should things intended for the screen end up
  2464.       // in a octave_value (string)?
  2465.  
  2466.       save_vars (argv, i, argc, octave_stdout, save_builtins, format,
  2467.          save_as_floats);
  2468.     }
  2469.  
  2470.   // Guard against things like `save a*', which are probably mistakes...
  2471.  
  2472.   else if (i == argc - 1 && glob_pattern_p (argv[i]))
  2473.     {
  2474.       print_usage ("save");
  2475.       return retval;
  2476.     }
  2477.   else
  2478.     {
  2479.       string fname = oct_tilde_expand (argv[i]);
  2480.  
  2481.       i++;
  2482.  
  2483.       unsigned mode = ios::out|ios::trunc;
  2484.       if (format == LS_BINARY || format == LS_MAT_BINARY)
  2485.     mode |= ios::bin;
  2486.  
  2487.       ofstream file (fname.c_str (), mode);
  2488.  
  2489.       if (file)
  2490.     {
  2491.       save_vars (argv, i, argc, file, save_builtins, format,
  2492.              save_as_floats);
  2493.     }
  2494.       else
  2495.     {
  2496.       error ("save: couldn't open output file `%s'", fname.c_str ());
  2497.       return retval;
  2498.     }
  2499.     }
  2500.  
  2501.   return retval;
  2502. }
  2503.  
  2504. // Maybe this should be a static function in tree-plot.cc?
  2505.  
  2506. // If TC is matrix, save it on stream OS in a format useful for
  2507. // making a 3-dimensional plot with gnuplot.  If PARAMETRIC is
  2508. // nonzero, assume a parametric 3-dimensional plot will be generated.
  2509.  
  2510. int
  2511. save_three_d (ostream& os, const octave_value& tc, int parametric)
  2512. {
  2513.   int fail = 0;
  2514.  
  2515.   int nr = tc.rows ();
  2516.   int nc = tc.columns ();
  2517.  
  2518.   if (tc.is_real_matrix ())
  2519.     {
  2520.       os << "# 3D data...\n"
  2521.      << "# type: matrix\n"
  2522.      << "# total rows: " << nr << "\n"
  2523.      << "# total columns: " << nc << "\n";
  2524.  
  2525.       if (parametric)
  2526.     {
  2527.       int extras = nc % 3;
  2528.       if (extras)
  2529.         warning ("ignoring last %d columns", extras);
  2530.  
  2531.       Matrix tmp = tc.matrix_value ();
  2532.       tmp = strip_infnan (tmp);
  2533.       nr = tmp.rows ();
  2534.  
  2535.       for (int i = 0; i < nc-extras; i += 3)
  2536.         {
  2537.           os << tmp.extract (0, i, nr-1, i+2);
  2538.           if (i+3 < nc-extras)
  2539.         os << "\n";
  2540.         }
  2541.     }
  2542.       else
  2543.     {
  2544.       Matrix tmp = tc.matrix_value ();
  2545.       tmp = strip_infnan (tmp);
  2546.       nr = tmp.rows ();
  2547.  
  2548.       for (int i = 0; i < nc; i++)
  2549.         {
  2550.           os << tmp.extract (0, i, nr-1, i);
  2551.           if (i+1 < nc)
  2552.         os << "\n";
  2553.         }
  2554.     }
  2555.     }
  2556.   else
  2557.     {
  2558.       ::error ("for now, I can only save real matrices in 3D format");
  2559.       fail = 1;
  2560.     }
  2561.  
  2562.   return (os && ! fail);
  2563. }
  2564.  
  2565. static int
  2566. default_save_format (void)
  2567. {
  2568.   int status = 0;
  2569.  
  2570.   string s = builtin_string_variable ("default_save_format");
  2571.  
  2572.   if (s.empty ())
  2573.     {
  2574.       gripe_invalid_value_specified ("default_save_format");
  2575.       status = -1;
  2576.     }
  2577.   else
  2578.     Vdefault_save_format = s;
  2579.  
  2580.   return status;
  2581. }
  2582.  
  2583. static int
  2584. save_precision (void)
  2585. {
  2586.   double val;
  2587.   if (builtin_real_scalar_variable ("save_precision", val)
  2588.       && ! xisnan (val))
  2589.     {
  2590.       int ival = NINT (val);
  2591.       if (ival >= 0 && (double) ival == val)
  2592.     {
  2593.       Vsave_precision = ival;
  2594.       return 0;
  2595.     }
  2596.     }
  2597.   gripe_invalid_value_specified ("save_precision");
  2598.   return -1;
  2599. }
  2600.  
  2601. void
  2602. symbols_of_load_save (void)
  2603. {
  2604.   DEFVAR (default_save_format, "ascii", 0, default_save_format,
  2605.     "default format for files created with save, may be one of\n\
  2606. \"binary\", \"text\", or \"mat-binary\"");
  2607.  
  2608.   DEFVAR (save_precision, 15.0, 0, save_precision,
  2609.     "number of significant figures kept by the ASCII save command");
  2610. }
  2611.  
  2612. /*
  2613. ;;; Local Variables: ***
  2614. ;;; mode: C++ ***
  2615. ;;; End: ***
  2616. */
  2617.